home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 11 / Amiga Format AFCD11 (Feb 1997, Issue 95).iso / -seriously_amiga- / commercial / ppaint7demo / rexx / loadanimgif.pprx < prev    next >
Text File  |  1997-01-31  |  7KB  |  265 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: LoadAnimGif.pprx 1.2 */
  4.  
  5. /** ENG
  6.  This script loads a GIF animation, and then either displays it with the
  7.  proper timing, or converts it into an IFF anim-brush (if the "Anim-Brush"
  8.  option is selected).
  9.  
  10.  GIF animation features such as frame-by-frame timing, multiple palettes,
  11.  control blocks, offsets and overlays are supported. Multiple transparencies
  12.  are not supported.
  13. */
  14.  
  15. /** DEU
  16.  Mit Hilfe dieses Skripts läßt sich eine GIF-Animation laden und dann
  17.  entweder mit dem korrekten Timing anzeigen oder in einen IFF-Anim-Brush
  18.  konvertieren (sofern die Option "Anim-Brush" aktiviert ist).
  19.  
  20.  Merkmale von GIF-Animationen, wie frameweises Timing, unterschiedliche
  21.  Paletten, Control Blocks, Offsets und Overlays werden unterstützt.
  22.  Unterschiedliche Transparenzwerte werden nicht unterstützt.
  23. */
  24.  
  25. IF ARG(1, EXISTS) THEN
  26.     PARSE ARG PPPORT
  27. ELSE
  28.     PPPORT = 'PPAINT'
  29.  
  30. IF ~SHOW('P', PPPORT) THEN DO
  31.     IF EXISTS('PPaint:PPaint') THEN DO
  32.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  33.         DO 30 WHILE ~SHOW('P',PPPORT)
  34.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  35.         END
  36.     END
  37.     ELSE DO
  38.         SAY "Personal Paint could not be loaded."
  39.         EXIT 10
  40.     END
  41. END
  42.  
  43. IF ~SHOW('P', PPPORT) THEN DO
  44.     SAY 'Personal Paint Rexx port could not be opened'
  45.     EXIT 10
  46. END
  47.  
  48. ADDRESS VALUE PPPORT
  49. OPTIONS RESULTS
  50. OPTIONS FAILAT 10000
  51.  
  52. Get 'LANG'
  53. IF RESULT = 1 THEN DO        /* Deutsch */
  54.     txt_title_req     = 'GIF-Anim-Brush laden'
  55.     txt_gad_absh      = 'Anim-_Brush:'
  56.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  57.     txt_err_oldlib    = 'Für dieses Skript ist eine neuere Version_der GIF library erforderlich'
  58.     txt_err_load      = 'Fehler beim Laden'
  59.     txt_err_notagif   = 'Die ausgewählte Datei enthält keine GIF-Animation'
  60.     txt_err_notsupp   = 'Das ausgewählte Animationsformat kann nicht geladen werden.'
  61.     txt_err_scrfmt    = 'Bildschirmformat kann nicht benutzt werden'
  62. END
  63. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  64.     txt_title_req     = 'Leggere Anim-brush GIF'
  65.     txt_gad_absh      = 'Anim-_Brush:'
  66.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  67.     txt_err_oldlib    = 'Questa procedura richiede_una versione più recente_della libreria GIF'
  68.     txt_err_load      = 'Errore nelle lettura del file'
  69.     txt_err_notagif   = 'Il file selezionato_non contiene un''animazione GIF'
  70.     txt_err_notsupp   = 'Il tipo di animazione non può essere letto'
  71.     txt_err_scrfmt    = 'Il formato di schermo non può essere utilizzato'
  72. END
  73. ELSE DO                /* English */
  74.     txt_title_req     = 'Load GIF Anim-Brush'
  75.     txt_gad_absh      = 'Anim-_Brush:'
  76.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  77.     txt_err_oldlib    = 'This script requires a newer_version of the GIF library'
  78.     txt_err_load      = 'Load error'
  79.     txt_err_notagif   = 'The selected file_does not contain_a GIF animation'
  80.     txt_err_notsupp   = 'The selected animation type_cannot be loaded'
  81.     txt_err_scrfmt    = 'The screen format cannot be set'
  82. END
  83.  
  84. Version 'REXX'
  85. IF RESULT < 7 THEN DO
  86.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  87.     EXIT 10
  88. END
  89.  
  90. LockGUI
  91. RequestFile '"'txt_title_req'"'
  92. IF RC = 0 THEN DO
  93.     gfile = RESULT
  94.     getbsh = LoadSet('GetBsh', 1)
  95.  
  96.     Request '"'txt_title_req'" "CHECK = ""'txt_gad_absh'"", 'getbsh'"'
  97.     IF RC = 0 THEN DO
  98.         getbsh = RESULT.1
  99.         CALL SaveSet('GetBsh', getbsh)
  100.         frame = 1
  101.         loop = -1
  102.         delays = ''
  103.         err_msg = ''
  104.         setup = 1
  105.  
  106.         Get 'GCLIP'
  107.         saveclip = RESULT
  108.         Set '"GCLIP=0"'
  109.  
  110.         DO FOREVER
  111.             LoadBrush gfile 'QUIET NOPROGRESS FORMAT "GIF" OPTIONS "FRAME='frame'"'
  112.             IF RC = 0 THEN DO
  113.                 IF setup THEN DO
  114.                     setup = 0
  115.                     SwitchEnvironment
  116.                     FreeEnvironment 'QUERY'
  117.                     IF RC ~= 0 THEN
  118.                         LEAVE
  119.                     DeleteFrames 'ALL FORCE'
  120.                     SetPen 'BACKGROUND 0'
  121.                     ClearImage
  122.                     GetBrushAttributes 'COLORS'
  123.                     cnum = RESULT
  124.                     GetBrushAttributes 'WIDTH'
  125.                     brushw = RESULT
  126.                     GetBrushAttributes 'HEIGHT'
  127.                     brushh = RESULT
  128.                     GetBestVideoMode brushw brushh cnum 'ANIMATION'
  129.                     PARSE VAR RESULT scrd scrw scrh
  130.                     Set '"IMAGEW='brushw'" "IMAGEH='brushh'" "COLORS='cnum'" "DISPLAY='scrd'" "SCREENW='scrw'" "SCREENH='scrh'" "ASCROLL=0"'
  131.                     IF RC ~= 0 THEN DO
  132.                         err_msg = txt_err_scrfmt
  133.                         LEAVE
  134.                     END
  135.                     GetBrushAttributes 'TRANSPARENCY'
  136.                     transp = RESULT
  137.                     GetBrushAttributes 'TRANSPARENTCOLOR'
  138.                     transpcol = RESULT
  139.                     SetPen 'BACKGROUND' transpcol
  140.                     ClearImage
  141.                     AddFrames
  142.                 END
  143.                 ELSE DO
  144.                     GetBrushAttributes 'TRANSPARENCY'
  145.                     transp2 = RESULT
  146.                     GetBrushAttributes 'TRANSPARENTCOLOR'
  147.                     transpcol2 = RESULT
  148.                     IF transp2 ~= transp | transpcol2 ~= transpcol THEN DO
  149.                         err_msg = txt_err_notsupp
  150.                         LEAVE
  151.                     END
  152.                 END
  153.                 UseBrushPalette
  154.                 SetPaintMode 'REPLACE'
  155.                 SetBrushAttributes 'HANDLEX 0 HANDLEY 0'
  156.                 PutBrush 0 0
  157.  
  158.                 GetBrushInfo 'ANNOTATION'
  159.                 IF RC = 0 THEN DO
  160.                     PARSE VALUE RESULT WITH 'LOOP ' loop ' DELAY ' delay .
  161.                     IF DATATYPE(delay, 'W') THEN DO
  162.                         delays = delays delay
  163.                         ticks = TRUNC(delay / 100 * 60 + 0.5)
  164.                         SetFrameDelay ticks
  165.                     END
  166.                 END
  167.  
  168.                 AddFrames
  169.                 SetFramePosition 'NEXT'
  170.                 frame = frame + 1
  171.             END
  172.             ELSE DO
  173.                 IF RC = 38 | (RC = 39 & frame <= 2) THEN
  174.                     err_msg = txt_err_notagif
  175.                 ELSE IF RC = 47 THEN
  176.                     err_msg = txt_err_oldlib
  177.                 ELSE IF RC ~= 39 THEN
  178.                     err_msg = txt_err_load
  179.                 LEAVE
  180.             END
  181.         END
  182.  
  183.         annot = ''
  184.         LoadBrush gfile 'QUIET NOPROGRESS'    /* reset to normal load (AUTO) */
  185.         IF RC = 0 THEN DO
  186.             GetBrushInfo 'ANNOTATION'
  187.             IF RC = 0 THEN
  188.                 annot = RESULT
  189.         END
  190.         FreeBrush 'FORCE'
  191.         DeleteFrames
  192.  
  193.         IF err_msg ~= '' THEN DO
  194.             RequestNotify 'PROMPT "'err_msg'"'
  195.             FreeEnvironment 'FORCE'
  196.         END
  197.         ELSE DO
  198.             SetFramePosition 1
  199.             IF RC = 0 THEN DO
  200.                 IF getbsh THEN DO
  201.                     Get 'TRANSP'
  202.                     sv_transp = RESULT
  203.  
  204.                     IF transp = 1 THEN
  205.                         Set '"TRANSP=' transp '"'
  206.                     ELSE
  207.                         Set '"TRANSP=0"'
  208.                     GetFrames
  209.                     DefineBrush 0 0 brushw-1 brushh-1 RESULT
  210.                     IF RC = 0 THEN DO
  211.                         FreeEnvironment 'FORCE'
  212.                         SetBrushInfo 'ANNOTATION "LOOP' loop 'DELAY' delays'"'
  213.                         IF annot ~= '' THEN DO
  214.                             pos = 1
  215.                             DO FOREVER
  216.                                 pos = INDEX(annot, '"', pos)
  217.                                 IF pos = 0 THEN
  218.                                     BREAK
  219.                                 annot = INSERT('"', annot, pos)
  220.                                 pos = pos + 2
  221.                             END
  222.                             SetBrushInfo 'COPYRIGHT "'annot'"'
  223.                         END
  224.                     END
  225.  
  226.                     Set '"TRANSP=' sv_transp '"'
  227.                 END
  228.                 ELSE Play 'FORCE'
  229.             END
  230.         END
  231.         Set '"GCLIP='saveclip'"'
  232.     END
  233. END
  234. UnlockGUI
  235.  
  236. EXIT 0
  237.  
  238.  
  239.  
  240.  
  241. SaveSet: PROCEDURE
  242.     sname = ARG(1)
  243.     val = ARG(2)
  244.  
  245.     IF OPEN('settingfile', 'ENV:PP_LoadAnimGIF_'sname, 'W') THEN DO
  246.         CALL WRITECH('settingfile', val)
  247.         CALL CLOSE('settingfile')
  248.     END
  249.  
  250.     RETURN
  251.  
  252.  
  253.  
  254.  
  255. LoadSet: PROCEDURE
  256.     sname = ARG(1)
  257.     val = ARG(2)
  258.  
  259.     IF OPEN('settingfile', 'ENV:PP_LoadAnimGIF_'sname, 'R') THEN DO
  260.         val = READCH('settingfile', 65535)
  261.         CALL CLOSE('settingfile')
  262.     END
  263.  
  264.     RETURN val
  265.